perm filename PLT2.F4[1,LCS] blob sn#579515 filedate 1981-04-11 generic text, type T, neo UTF8
C>BM=66 LM=1 TM=1 J=N    
C******* PLT/FOR ****** LOAD WITH KEYIN/REL  
C**** READS LIST OF X,Y COORDINATES.  IF 3RD NUM.<>0 THEN JUMP.  
      EXTERNAL KEYIN
      DIMENSION NN(3,500),MM(100)  
      REAL*8 NAME   
      INTEGER*1 CONEX,KEYIN,S,NA,ISTAR,MM,IBLA    
      DATA IBLA/' '/,S/'S'/   
302   FORMAT(' TYPE ''S'' TO STOP PRINTING ')
89    FORMAT(' TYPE FILE NAME ')   
300   WRITE(5,89)   
      REWIND 1 
91    FORMAT(A8)    
92    FORMAT(1XA8)  
      READ(5,91)NAME
      WRITE(5,92)NAME    
      WRITE(5,93)   
      READ(5,1)JWIDTH    
      IF(JWIDTH.LT.80)JWIDTH=80    
      IF(JWIDTH.GT.100)JWIDTH=100  
93    FORMAT(' TYPE NUMBER OF CHARACTERS WIDE ')  
94    FORMAT(' TYPE X,Y SIZE FACTORS ') 
95    FORMAT(2F6.3) 
      WRITE(5,94)   
      READ(5,95)XSIZE,YSIZE   
      IF(XSIZE.LT.0.1)XSIZE=1.
      IF(YSIZE.LT.0.1)YSIZE=1.
      WRITE(5,95)XSIZE,YSIZE  
      CALL OPEN(1,NAME,256)   
      WRITE(5,88)   
      READ(5,1)ISTAR
      WRITE(5,30)ISTAR   
96    FORMAT(' TYPE HORIZONTAL DISPLACEMENT ')    
      WRITE(5,96)   
      READ(5,1)JDIS 
88    FORMAT(' TYPE CHARACTER NUMBER (42=*, 65=A) ')   
1     FORMAT(3I4)   
30    FORMAT(1X,3I4)
200   FORMAT(' 2=LPT, 5=CRT ')
      WRITE(5,200)  
      READ(5,1)IDEV 
      IF(IDEV.EQ.5)JWIDTH=64  
      N=0 
      KK=1
      WRITE(5,302)  
100   READ(1,1,END=90)I,J,K   
      IF(I.LT.0)GO TO 90 
C -1 ENDS INPUT
      NN(3,KK)=K    
      A=I*XSIZE
      I=A 
C DO X,Y SCALING    
      A=J*YSIZE
      J=A 
      IF(N.LT.J)N=J 
C  N HOLDS HIGHEST LINE NUMBER
      NN(1,KK)=I+JDIS    
      NN(2,KK)=J    
      KK=KK+1  
      GO TO 100
90    DO 7 K=1,JWIDTH    
7     MM(K)=IBLA    
12    LL=1
      KA=1
2     K=NN(1,LL)    
      L=NN(2,LL)    
      M=NN(3,LL)    
      IF(M.LT.0)GO TO 80 
9     IF(M.EQ.0)GO TO 3  
5     I=K 
      J=L 
C  SAVE PREVIOUS POINT   
      GO TO 80 
10    I=1 
      IF(NN(3,LL+1).NE.0)I=-I 
      NN(3,LL)=I    
C MARK SEGS ENTIRELY ABOVE CURRENT LINE.
      GO TO 5  
3     IF(L.LT.N.AND.J.LT.N)GO TO 5 
      IF(L.GT.N.AND.J.GT.N)GO TO 10
C JUMP IF BOTH Y COORDS ARE LOWER THAN THIS LINE. 
8     X=K-I    
      IF(X.NE.0)GO TO 13 
      M=K 
C VERTICAL LINE
      IF(M.GT.JWIDTH)GO TO 5  
      IF(M.LT.1)GO TO 5  
      GO TO 14 
13    Y=L-J    
      IF(Y.NE.0)GO TO 15 
      IF(K.GT.I)GO TO 16 
      JA=K
      JB=I
      GO TO 17 
16    JA=I
      JB=K
17    IF(JB.LT.1)GO TO 5 
      IF(JB.GT.JWIDTH)JB=JWIDTH    
      IF(JA.GT.JWIDTH)JA=JWIDTH    
      IF(JA.LT.1)JA=1    
      DO 18 M=JA,JB 
18    MM(M)=ISTAR   
C HORIZONTAL LINE   
      NN(3,LL)=1    
      M=JB
      GO TO 19 
C LENGTHS OF X AND Y SEGMENTS 
15    IF(K.LT.I)GO TO 40 
      JK=K
      JI=I
      JJ=J
      JL=L
      GO TO 41 
40    JK=I
      JI=K
      JJ=L
      JL=J
      JJ=L
41    X=JK-JI  
      Y=JL-JJ  
      UU=JI+.5 
      A=N-JJ   
      U=JJ+.5  
      H=Y/X    
      NA=0
      DO 42 JC=JI,JK
      V=JC-JI  
      LA=H*V+U 
      IF(LA.LT.N)GO TO 43
      IF(LA.EQ.N)GO TO 45
      IF(NA.LT.0)GO TO 44
      NA=1
      GO TO 42 
43    IF(NA.GT.0)GO TO 44
      NA=-1    
      GO TO 42 
44    B=A/H+UU 
      M=B 
      GO TO 46 
45    M=JC
46    NA=0
      IF(M.GT.JWIDTH)GO TO 42 
      IF(M.LT.1)GO TO 42 
      MM(M)=ISTAR   
      IF(M.GT.KA)KA=M    
42    CONTINUE 
      GO TO 5  
14    MM(M)=ISTAR   
C SOLID GRAPHICS CHAR.   
19    IF(M.GT.KA)KA=M    
      IF(KA.GT.JWIDTH)KA=JWIDTH    
      GO TO 5  
80    LL=LL+1  
      IF(LL.LT.KK)GO TO 2
C GO BACK AND LOOK AT MORE VECTORS 
C     WRITE(5,20)(MM(K),K=1,KA)    
      WRITE(IDEV,20)(MM(K),K=1,KA) 
      N=N-1    
      IF(KEYIN.NE.S)GO TO 301 
      IF(CONEX(N).NE.0)GO TO 300   
301   IF(N.GE.0)GO TO 90 
      WRITE(IDEV,20)IBLA 
C SO LAST REAL LINE WILL PRINT
20    FORMAT(1X,100A1)   
      END 
C    
      FUNCTION CONEX(Q)  
      EXTERNAL KEYIN
      INTEGER*1 J,CONEX,KEYIN,G,N,X
      COMMON /KEY/X,N,G  
C3     FORMAT(1X4A1)
2     FORMAT(' G=GO, N=NEW FILE, X=EXIT ')   
      WRITE(5,2)    
      CONEX=0  
1     J=KEYIN  
      IF(J.EQ.G)RETURN   
      IF(J.EQ.X)STOP *DONE*   
      IF(J.NE.N)GO TO 1  
C     WRITE(5,3)J,X,N,G  
      CONEX=-1 
      RETURN   
      END 
C    
      BLOCK DATA LTRS    
      INTEGER*1 X,N,G    
      COMMON /KEY/X,N,G  
      DATA X/'X'/,N/'N'/,G/'G'/    
      END